Paralympic Medals

1 Result

2 Setup

pacman::p_load(
  ggforce, 
  glue,
  here,
  magrittr,
  tidyverse
)

3 Background

Background information: Tidy Tuesday
Data source: International Paralympic Committee

3.1 Data Dictionary

4 Raw Data

Get data and write to local file

# get data
paralympics <- tidytuesdayR::tt_load(yr, week = wk) %>% 
  pluck("athletes")

# write to local file 
write_csv(paralympics, here("data", glue("data_{yr}_{wk}_1.csv")))

Read data from local file (d_raw) and create working copy (d)

# raw data
d_raw <- read_csv(
  here("data", glue("data_{yr}_{wk}_1.csv")),
  col_types = cols(.default = "c"),
  na = c("NA", "NULL", "")
)
# working copy
d <- d_raw

5 Inspection

d

glimpse(d)

## Rows: 19,547
## Columns: 10
## $ gender  <chr> "Men", "Men", "Men", "Men", "Men", "Men", "Men", "Men", "Men",…
## $ event   <chr> "Double FITA Round Amputee", "Double FITA Round Amputee", "Dou…
## $ medal   <chr> "Gold", "Silver", "Bronze", "Gold", "Silver", "Bronze", "Gold"…
## $ athlete <chr> "LARSEN Finn", "BRENNE Manfred", "SATO Masao", "GEISS H.", "GR…
## $ abb     <chr> "DEN", "FRG", "JPN", "FRG", "BEL", "GBR", "CAN", "NOR", "FRA",…
## $ country <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
## $ grp_id  <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
## $ type    <chr> "Archery", "Archery", "Archery", "Archery", "Archery", "Archer…
## $ year    <chr> "1980", "1980", "1980", "1980", "1980", "1980", "1980", "1980"…
## $ guide   <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…

6 Coercion

d %<>% mutate(across(c("year", "grp_id"),  ~ as.numeric(.x)))
d %<>% mutate(across(c("gender", "medal", "abb", "country", "type"),  ~ factor(.x)))

7 Exploration

7.1 skimr

skimr::skim(d)

Data summary

Name	d
Number of rows	19547
Number of columns	10
_______________________
Column type frequency:
character	3
factor	5
numeric	2
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
event	0	1.00	3	40	0	1670	0
athlete	435	0.98	1	44	0	6779	0
guide	19494	0.00	8	39	0	42	0

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
gender	144	0.99	FALSE	3	Men: 11982, Wom: 7182, Mix: 239
medal	0	1.00	FALSE	3	Gol: 6611, Sil: 6470, Bro: 6466
abb	49	1.00	FALSE	117	USA: 1901, GBR: 1424, CHN: 1319, FRA: 1178
country	14428	0.26	FALSE	137	Uni: 504, Fra: 452, Chi: 408, Aus: 361
type	0	1.00	FALSE	11	Ath: 7713, Swi: 6220, Tab: 1393, Whe: 1370

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
grp_id	14428	0.26	3.42	3.08	1	1	2	4	24	▇▁▁▁▁
year	0	1.00	1996.72	11.30	1980	1988	1996	2008	2016	▇▇▇▆▆

guide is empty; drop column

d %<>% select(-guide) 

7.2 DataExplorer

DataExplorer::introduce(d) %>% 
  pivot_longer(cols = everything())

8 Data Preparation

I’ve been intrigued to create something similar to Shirley Wu’s Film Flowers in R. I’ve recreated Shirley’s project before with SVG and D3.js, but didn’t know if it would be possible to achieve a similar result in R. I ended up using geom_bezier() from the ggforce package to draw the petals. And instead of rotating SVG groups, I used coord_polar() to arrange the shapes around the origin. A disadvantage of coord_polar() is the distortion (especially towards the center). So there may be better alternatives. But for this project, the distortion was acceptable.

I created petal-shaped decorations on all medals of the greatest Paralympic athlete of all time: Trischa Zorn. She won 46 (official stats) or 55 (unofficial stats) swimming medals during 7 Paralympic events. The number of petals represents the distance (on a non-linear scale: 2 = 50m, 4 = 100m, 6 = 200m, 8 = 400m), and the shape of the petal represents the swimming style (backstroke, breaststroke, butterfly, freestyle or medley).

8.1 Filter

d %>% filter(str_detect(str_squish(str_to_lower(athlete)), "zorn trischa"))

Filtering the data for Trischa Zorn results in 44 records. But according to online resources, she won either 46 (official IPC count) or 55 Paralympic medals. In de early days they weren’t really keeping track of the events, therefore not all medals were officially recorded. Read more: Interview with Trischa Zorn

8.2 Discrepancies

44 medals is 2 less than the official count of 46. Her active period was from 1980-2004 –within the timeframe of the data (1980-2016). So, that cannot be the explanation. It could result from typing errors.

Search for "zorn" (without the first name):

d %>% 
  filter(str_detect(str_squish(str_to_lower(athlete)), "zorn")) %>% 
  pull(athlete) %>% 
  unique()

## [1] "PIZZORNI Orazio" "ZORN Trischa"

Search for "trischa" (without the last name):

d %>% 
  filter(str_detect(str_squish(str_to_lower(athlete)), "trischa")) %>% 
  pull(athlete) %>% 
  unique()

## [1] "ZORN Trischa"

Use the stringdist package to compute the distance between the athlete string and "zorn trischa" (and return similar names):

d %>% 
  mutate(distance = stringdist::stringdist(
      str_squish(str_to_lower(athlete)), 
      "zorn trischa")) %>% 
  arrange(distance) %>% 
  select(athlete, distance) %>% 
  distinct() %>% 
  slice_head(n = 10)

8.3 Replace Data

Since I couldn’t identify the cause of the discrepancy, I decided to copy the HTML table from https://db.ipc-services.org/sdms/hira/web/paralympians.

d <- html_table(read_html(glue("{wd}/tbl/zorn.html")))[[2]]
colnames(d) <- c("games", "sport", "event", "medal")
d

8.4 Wrangle

d %<>% 
  mutate(
    year = as.integer(str_sub(games, -4, -1)),
    place = factor(str_sub(games, 1, -6)),
    event = str_remove(event, "Women's ") %>% 
      str_replace(" m ", "m ") %>% 
      str_replace("Individual Medley", "Medley"),
    medal = str_remove(medal, " Medal") %>% str_replace("-", ""),
    rank = case_when(
      medal == "Gold" ~ 1,
      medal == "Silver" ~ 2,
      medal == "Bronze" ~ 3
    )) %>% 
  select(-games) %>% 
  separate(
    col = "event",
    into = c("distance", "style", "classification"),
    sep = " "
  ) %>% 
  mutate(
    across(
      c("sport", "style", "classification", "medal"), 
      ~ as.factor(.x))) %>% 
  mutate(
    meters = case_when(
      distance == "4x100m" ~ 100,
      distance == "4x50m" ~ 50,
      TRUE ~ parse_number(distance)
    )) %>% 
  mutate(four_times = str_detect(distance, "4x"))

This indeed results in the expected medal count of 46.

d %>% count(medal)

Filter races with medals

d %<>% filter(medal != "")

Add columns for visualization

d %<>% 
  arrange(year, rank, style, meters) %>% 
  rowid_to_column() %>% 
  rename(id = rowid) %>%
  group_by(year) %>% 
  mutate(seq = row_number()) %>% 
  ungroup() %>% 
  mutate(
    reps_linear = meters / 25,
    reps_nonlinear = recode(
      meters,
      `50` = 2,
      `100` = 4,
      `200` = 6,
      `400` = 8),
    shape = recode(
      style,
      "Freestyle" = 1,
      "Medley" = 2,
      "Breaststroke" = 3,
      "Backstroke" = 4,
      "Butterfly" = 5)
  ) %>% 
  group_by(style, distance) %>% 
  mutate(nth_type = row_number()) %>%
  ungroup()

color_medals <- c("#dfb70f", "#b3b8bc", "#ae7057")

d %<>% left_join(
  tribble(
    ~medal, ~main,
    "Gold", color_medals[1],
    "Silver", color_medals[2],
    "Bronze", color_medals[3]) %>% 
  mutate(
    lighter = colorspace::lighten(main, amount = 0.4) %>% tolower(),
    darker = colorspace::darken(main, amount = 0.1) %>% tolower()), 
  by = "medal")

Inspect data

d

glimpse(d)

## Rows: 46
## Columns: 19
## $ id             <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, …
## $ sport          <fct> Swimming, Swimming, Swimming, Swimming, Swimming, Swimm…
## $ distance       <chr> "100m", "100m", "100m", "4x50m", "4x100m", "100m", "100…
## $ style          <fct> Backstroke, Butterfly, Freestyle, Medley, Medley, Backs…
## $ classification <fct> B, B, B, B, B, B2, B2, B2, B2, B2, B2, B2, B2, B2, B2, …
## $ medal          <chr> "Gold", "Gold", "Gold", "Gold", "Gold", "Gold", "Gold",…
## $ year           <int> 1980, 1980, 1980, 1980, 1980, 1984, 1984, 1984, 1984, 1…
## $ place          <fct> Arnhem, Arnhem, Arnhem, Arnhem, Arnhem, Stoke Mandevill…
## $ rank           <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ meters         <dbl> 100, 100, 100, 50, 100, 100, 100, 100, 200, 400, 100, 5…
## $ four_times     <lgl> FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, F…
## $ seq            <int> 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 6, 7, 8, 9…
## $ reps_linear    <dbl> 4, 4, 4, 2, 4, 4, 4, 4, 8, 16, 4, 2, 4, 8, 4, 2, 4, 16,…
## $ reps_nonlinear <dbl> 4, 4, 4, 2, 4, 4, 4, 4, 6, 8, 4, 2, 4, 6, 4, 2, 4, 8, 6…
## $ shape          <dbl> 4, 5, 1, 2, 2, 4, 5, 1, 2, 2, 4, 3, 3, 3, 5, 1, 1, 1, 2…
## $ nth_type       <int> 1, 1, 1, 1, 1, 2, 2, 2, 1, 1, 3, 1, 1, 1, 3, 1, 3, 1, 2…
## $ main           <chr> "#dfb70f", "#dfb70f", "#dfb70f", "#dfb70f", "#dfb70f", …
## $ lighter        <chr> "#fbd24c", "#fbd24c", "#fbd24c", "#fbd24c", "#fbd24c", …
## $ darker         <chr> "#c7a307", "#c7a307", "#c7a307", "#c7a307", "#c7a307", …

Write data as .csv

d %>% write_csv(here("data", glue("data_{yr}_{wk}_2.csv")))

9 Draw Medals

sysfonts::font_add_google(name = "Barlow Semi Condensed", family = "barlow")
showtext::showtext_auto()

txt_dark <- "#282822"
txt_light <- "#7a766f"

9.1 Shapes

9.1.1 Create

shapes <- list(
  tribble(
    ~line, ~x, ~y,
    1, 0, 10,
    1, 50, 40,
    1, 50, 70,
    1, 20, 100,
    2, 20, 100,
    2, 10, 90,
    2, 0, 85,
    3, 0, 85,
    3, -10, 90,
    3, -20, 100,
    4, -20, 100,
    4, -50, 70,
    4, -50, 40,
    4, 0, 10
  ),
  tribble(
    ~line, ~x, ~y,
    1, 0, 10,
    1, 50, 25,
    1, 50, 75,
    1, 0, 100,
    2, 0, 100,
    2, -50, 75,
    2, -50, 25,
    2, 0, 10, 
  ),
  tribble(
    ~line, ~x, ~y,
    1, -35, 10,
    1, -25, 75, 
    1, 25, 75,
    1, 35, 10,
    2, 35, 10,
    2, 50, 25,
    2, 25, 75,
    2, 0, 100,
    3, 0, 100,
    3, -25, 75,
    3, -50, 25,
    3, -35, 10
  ),
  tribble(
    ~line, ~x, ~y,
    1, 0, 40,
    1, -15, 40,
    1, -10, 10,
    2, -10, 10,
    2, -40, 10,
    2, -40, 50,
    3, -40, 50,
    3, -40, 90,
    3, -20, 100,
    4, -20, 100,
    4, -30, 75,
    4, -10, 60,
    5, -10, 60,
    5, -5, 80,
    5, 0, 80,
    6, 0, 80,
    6, 5, 80,
    6, 10, 60,
    7, 10, 60,
    7, 30, 75,
    7, 20, 100,
    8, 20, 100,
    8, 40, 90,
    8, 40, 50,
    9, 40, 50,
    9, 40, 10,
    9, 10, 10,
    10, 10, 10,
    10, 15, 40,
    10, 0, 40
  ),
  tribble(
    ~line, ~x, ~y,
    1, 0, 100,
    1, -10, 65,
    1, -35, 100,
    1, -40, 85,
    2, -40, 85,
    2, -45, 75,
    2, -45, 55,
    2, -20, 10,
    3, -20, 10,
    3, -30, 80,
    3, -30, 80,
    3, 0, 55,
    4, 0, 55,
    4, 30, 80,
    4, 30, 80,
    4, 20, 10,
    5, 20, 10,
    5, 45, 55,
    5, 45, 75,
    5, 40, 85,
    6, 40, 85,
    6, 35, 100,
    6, 10, 65,
    6, 0, 100
  )
)

9.1.2 Transform

shapes %<>% map(~.x %>% 
                rename(x_src = x) %>% 
                mutate(
                  # shift x to start at 0 (only positive values)
                  x_abs = x_src + abs(min(x_src)),
                  # normalize x to range 0-100
                  x = x_abs / max(x_abs) * 100) %>% 
                select(-x_abs, -x_src)) 

9.1.3 Total Width

total_width <- max(d$reps_nonlinear) * 100

9.1.4 Preview

Preview single shapes

preview_single <- function(tbl){
  ggplot() +
    ggforce::geom_bezier(aes(x = x, y = y, group = line), data = tbl) +
    lims(x = c(0, 100), y = c(0, 100)) +
    theme_void() +
    coord_fixed(ratio = 2)
}

preview_single(shapes[[1]])

preview_single(shapes[[2]])

preview_single(shapes[[3]])

preview_single(shapes[[4]])

preview_single(shapes[[5]])

Preview polar shapes

preview_polar <- function(tbl, n){
  preview <- tibble()
  for (j in 1:n) {
    shape <- tbl %>%
      mutate(
        shape_id = rep(j, nrow(.)),
        line = paste(j, line, sep = "-"),
        xgrid = x + (j - 1) * (total_width / n)
      )
    preview %<>% bind_rows(shape)
  }
  ggplot() +
    ggforce::geom_bezier(aes(x = xgrid, y = y, group = line), data = preview) +
    scale_x_continuous(limits = c(0, total_width)) +
    scale_y_continuous(limits = c(0, 100)) +
    theme_void() +
    coord_polar()
}

preview_polar(shapes[[1]], 6)

preview_polar(shapes[[2]], 6)

preview_polar(shapes[[3]], 6)

preview_polar(shapes[[4]], 6)

preview_polar(shapes[[5]], 6)

9.2 Coordinates

pd <- tibble()

for(i in 1:nrow(d)){
  n <- d$reps_nonlinear[i]
  step <- total_width / n
  tbl <- tibble()
  for(j in 1:n){
    shape <- shapes[[d$shape[i]]] %>% 
      mutate(
        shape_id = rep(j, nrow(.)),
        line = paste(j, line, sep = "-"),
        xgrid = x + (j - 1) * step)
    tbl %<>% bind_rows(shape)
  }
  tbl %<>% mutate(medal_id = rep(d$id[i], nrow(.)))
  pd %<>% bind_rows(tbl) 
}

pd %<>% left_join(d, by = c("medal_id" = "id"))
pd

9.3 Draw Medals

9.3.1 Add Shapes and Facet

ggplot(data = pd) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "black", 
    size = 0.45) +
  facet_grid(seq ~ year)

ggsave(glue("{wd}/img/medals_step_1.png"))

9.3.2 Add Medal Colors

ggplot(data = pd) +
  geom_rect(
    aes(fill = main),
    xmin = 0, 
    xmax = total_width, 
    ymin = 0, 
    ymax = 120) +
  geom_rect(
    aes(fill = darker),
    xmin = 0, 
    xmax = total_width, 
    ymin = 120,
    ymax = 160) +
  geom_rect(
    aes(fill = lighter),
    xmin = 0, 
    xmax = total_width, 
    ymin = 160, 
    ymax = 170) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "white", 
    size = 0.45) +
  scale_fill_identity() +
  facet_grid(seq ~ year)

ggsave(glue("{wd}/img/medals_step_2.png"))

9.3.3 Polar Coordinates

ggplot(data = pd) +
  geom_rect(
    aes(fill = main),
    xmin = 0, 
    xmax = total_width, 
    ymin = 0, 
    ymax = 120) +
  geom_rect(
    aes(fill = darker),
    xmin = 0, 
    xmax = total_width, 
    ymin = 120,
    ymax = 160) +
  geom_rect(
    aes(fill = lighter),
    xmin = 0, 
    xmax = total_width, 
    ymin = 160, 
    ymax = 170) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "white", 
    size = 0.45) +
  scale_fill_identity() +
  scale_x_continuous(limits = c(0, total_width)) +
  scale_y_continuous(limits = c(0, 170)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_grid(seq ~ year)

ggsave(glue("{wd}/img/medals_step_3.png"))

9.3.4 Add Details

seq_data <- tibble()

for(i in 1:nrow(d)){
  s <- rep(d$seq[i], d$nth_type[i])
  y <- rep(d$year[i], d$nth_type[i])
  n <- 1:d$nth_type[i]
  f <- rep(d$lighter[i], d$nth_type[i])
  seq_data %<>% bind_rows(
    tibble(
      seq = s, 
      year = y, 
      nth = n, 
      clr = f,
      x = n * 40))
}

ggplot(data = pd) +
  geom_rect(
    aes(fill = main),
    xmin = 0, 
    xmax = total_width, 
    ymin = 0, 
    ymax = 120) +
  geom_rect(
    aes(fill = darker),
    xmin = 0, 
    xmax = total_width, 
    ymin = 120,
    ymax = 160) +
  geom_rect(
    aes(fill = lighter),
    xmin = 0, 
    xmax = total_width, 
    ymin = 160, 
    ymax = 170) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "white", 
    size = 0.45) +
  geom_point(
    aes(x = x, color = clr), 
    y = 140, 
    size = 2, 
    data = seq_data) + 
  geom_point(
    aes(
      fill = ifelse(four_times, "white", NA),
      color = ifelse(four_times, lighter, NA)), 
    x = total_width / 2, 
    y = 0, 
    size = 5, 
    shape = 21) +
  scale_fill_identity() +
  scale_color_identity() +
  scale_x_continuous(limits = c(0, total_width)) +
  scale_y_continuous(limits = c(0, 170)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_grid(seq ~ year)

ggsave(glue("{wd}/img/medals_step_4.png"))

9.3.5 Theme Adjustments

ggplot(data = pd) +
  geom_rect(
    aes(fill = main),
    xmin = 0, 
    xmax = total_width, 
    ymin = 0, 
    ymax = 120) +
  geom_rect(
    aes(fill = darker),
    xmin = 0, 
    xmax = total_width, 
    ymin = 120,
    ymax = 160) +
  geom_rect(
    aes(fill = lighter),
    xmin = 0, 
    xmax = total_width, 
    ymin = 160, 
    ymax = 170) +
  geom_bezier(
    aes(x = xgrid, y = y, group = line), 
    color = "white", 
    size = 0.45) +
  geom_point(
    aes(x = x, color = clr), 
    y = 140, 
    size = 2, 
    data = seq_data) + 
  geom_point(
    aes(
      fill = ifelse(four_times, "white", NA),
      color = ifelse(four_times, lighter, NA)), 
    x = total_width / 2, 
    y = 0, 
    size = 5, 
    shape = 21) +
  # geom_text(
  #   aes(label = ifelse(four_times, "4", NA)),
  #   color = txt_light,
  #   x = total_width / 2, 
  #   y = 0) +
  scale_fill_identity() +
  scale_color_identity() +
  scale_x_continuous(limits = c(0, total_width)) +
  scale_y_continuous(limits = c(0, 170)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_grid(seq ~ year) +
  theme_void() +
  theme(
    strip.text.x = element_blank(),
    strip.text.y = element_blank(),
    panel.spacing = unit(0, "lines"),
    legend.position = "none")

9.3.6 Save

ggsave(glue("{wd}/img/medals.pdf"), width = 2800, height = 4800, unit = "px")
ggsave(glue("{wd}/img/medals.png"), width = 2800, height = 4800, unit = "px")

9.4 Draw Legends

9.4.1 Shape Legend

shape_legend <- tibble()

for(i in 1:5){
  n <- 6
  step <- total_width / n
  tbl <- tibble()
  for(j in 1:n){
    shape <- shapes[[i]] %>% 
      mutate(
        lineid = rep(j, nrow(.)),
        line = paste(j, line, sep = "-"),
        xgrid = x + (j - 1) * step)
    tbl %<>% bind_rows(shape)
  }
  shape_legend %<>% bind_rows(tbl %>% mutate(item = i)) 
}

shape_labels <- d %>% 
  select(style, shape) %>% 
  distinct() %>% 
  pull(style) %>% 
  as.character()

names(shape_labels) <- d %>% 
  select(style, shape) %>% 
  distinct() %>% 
  pull(shape) 

ggplot(data = shape_legend) +
  ggforce::geom_bezier(aes(x = xgrid, y = y, group = line), color = txt_light) +
  scale_y_continuous(limits = c(0, 100)) +
  scale_x_continuous(limits = c(0, total_width)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_wrap(
    ~item, 
    ncol = 1, 
    labeller = as_labeller(shape_labels), 
    strip.position = "bottom") +
  theme(
    line = element_blank(),
    legend.position = "none",
    plot.background = element_blank(),
    panel.background = element_blank(),
    strip.text.x = element_text(family = "barlow", size = 12, hjust = 0.5, color = txt_dark),
    strip.background = element_rect(fill = NA, color = NA),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_blank()
    )

ggsave(glue("{wd}/img/legend_shape.pdf"), width = 500, height = 2500, units = "px")
ggsave(glue("{wd}/img/legend_shape.png"), width = 500, height = 2500, units = "px")

9.4.2 Count Legend

count_legend <- tibble()

for(petals in c(2, 4, 6, 8)){
  step <- total_width / petals
  tbl <- tibble()
  for(i in 1:petals){
    shape <- shapes[[1]] %>% 
      mutate(
        lineid = rep(i, nrow(.)),
        line = paste(i, line, sep = "-"),
        xgrid = x + (i - 1) * step)
    tbl %<>% bind_rows(shape)
  }
  count_legend %<>% bind_rows(tbl %>% mutate(item = i)) 
}

count_labels <- c("50m", "100m", "200m", "400m")
names(count_labels) <- c(2, 4, 6, 8)

ggplot(data = count_legend) +
  ggforce::geom_bezier(aes(x = xgrid, y = y, group = line), color = txt_light) +
  scale_y_continuous(limits = c(0, 100)) +
  scale_x_continuous(limits = c(0, total_width)) +
  coord_polar(start = -((pi / (total_width / 2)) * 50)) +
  facet_wrap(
    ~item, 
    ncol = 1, 
    labeller = as_labeller(count_labels), 
    strip.position = "bottom") +
  theme(
    line = element_blank(),
    legend.position = "none",
    plot.background = element_blank(),
    panel.background = element_blank(),
    strip.text.x = element_text(family = "barlow", size = 12, hjust = 0.5, color = txt_dark),
    strip.background = element_rect(fill = NA, color = NA),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_blank()
    )

ggsave(
  glue("{wd}/img/legend_count.pdf"), 
  width = 500, 
  height = 2000, 
  units = "px")

ggsave(
  glue("{wd}/img/legend_count.png"), 
  width = 500, 
  height = 2000, 
  units = "px")

9.4.3 Column Headers

d %>% select(year, place) %>% distinct()

10 Session Info

Sys.time()

## [1] "2021-08-10 14:04:10 CEST"

sessionInfo()

## R version 4.0.5 (2021-03-31)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS Big Sur 10.16
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/nl_NL.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] rvest_1.0.0     here_1.0.1      glue_1.4.2      ggforce_0.3.3  
##  [5] magrittr_2.0.1  forcats_0.5.1   stringr_1.4.0   dplyr_1.0.7    
##  [9] purrr_0.3.4     readr_2.0.0     tidyr_1.1.3     tibble_3.1.3   
## [13] ggplot2_3.3.5   tidyverse_1.3.1
## 
## loaded via a namespace (and not attached):
##  [1] fs_1.5.0           usethis_2.0.1.9000 lubridate_1.7.10   bit64_4.0.5       
##  [5] httr_1.4.2         rprojroot_2.0.2    repr_1.1.3         tools_4.0.5       
##  [9] backports_1.2.1    bslib_0.2.5.1      utf8_1.2.2         R6_2.5.0          
## [13] DBI_1.1.1          colorspace_2.0-2   withr_2.4.2        gridExtra_2.3     
## [17] tidyselect_1.1.1   bit_4.0.4          curl_4.3.2         compiler_4.0.5    
## [21] textshaping_0.3.5  cli_3.0.1          pacman_0.5.1       xml2_1.3.2        
## [25] labeling_0.4.2     sass_0.4.0         scales_1.1.1       rappdirs_0.3.3    
## [29] systemfonts_1.0.2  digest_0.6.27      rmarkdown_2.9      stringdist_0.9.6.3
## [33] showtext_0.9-2     base64enc_0.1-3    pkgconfig_2.0.3    htmltools_0.5.1.1 
## [37] dbplyr_2.1.1       highr_0.9          htmlwidgets_1.5.3  rlang_0.4.11      
## [41] readxl_1.3.1       sysfonts_0.8.3     rstudioapi_0.13    jquerylib_0.1.4   
## [45] farver_2.1.0       generics_0.1.0     jsonlite_1.7.2     vroom_1.5.3       
## [49] Rcpp_1.0.7         munsell_0.5.0      fansi_0.5.0        lifecycle_1.0.0   
## [53] stringi_1.7.3      yaml_2.2.1         MASS_7.3-54        grid_4.0.5        
## [57] parallel_4.0.5     crayon_1.4.1       haven_2.4.3        hms_1.1.0         
## [61] DataExplorer_0.8.2 knitr_1.33         pillar_1.6.2       igraph_1.2.6      
## [65] reprex_2.0.0       evaluate_0.14      data.table_1.14.0  modelr_0.1.8      
## [69] png_0.1-7          vctrs_0.3.8        tzdb_0.1.2         tweenr_1.0.2.9000 
## [73] selectr_0.4-2      networkD3_0.4      cellranger_1.1.0   gtable_0.3.0      
## [77] polyclip_1.10-0    assertthat_0.2.1   xfun_0.24          skimr_2.1.3       
## [81] broom_0.7.9        ragg_1.1.3         showtextdb_3.0     ellipsis_0.3.2